program bspline_curve ;

{$U+}

const
  numstate = $20 ;

type
   arry = array [1..20,1..2] of integer ;

 var
   knotk , knotn , n , k , i , j : integer ;
   arr : arry ;
   m , x , y : real ;
   x1 , y1 , x2 , y2 , flag , ctr : integer ;
   c : char ;
   kbflag : byte absolute $0040:$0017 ;

procedure setnum ;
 begin
   kbflag := kbflag or numstate ;
 end ;

procedure resetnum ;
 begin
   kbflag := kbflag and 0 ;
 end ;

 function knot ( i : integer ) : integer ;
  begin
   if i < knotk then
     knot := 0
   else
     if i > knotn then
       knot := knotn - knotk + 2
     else
       knot := i - knotk + 1 ;
  end ;

 function nblend ( i , k : integer ; u : real ) : real ;
  var
    t:integer ;
    v:real ;
  begin
   if k = 1 then
    begin
      v := 0 ;
      if ( knot( i ) <= u ) and ( u < knot( i + 1 ) ) then
         v := 1 ;
    end
   else
    begin
      v := 0 ;
      t := knot( i + k - 1 ) - knot( i ) ;
      if t <> 0 then
        v := ( u - knot( i ) ) * nblend( i , k - 1 , u ) / t ;
      t := knot( i + k ) - knot( i + 1 ) ;
      if t <> 0 then
        v := v + ( knot( i + k ) - u ) * ( nblend( i + 1 , k - 1 , u ) / t ) ;
    end ;
    nblend := v ;
  end ;

 procedure spline( var x , y : real ; u : real ; n , k : integer ; var a : arry ) ;
  var
   i : integer ;
   b : real ;
  begin
    knotk := k ;
    knotn := n ;
    x := 0 ;
    y := 0 ;
    for i := 1 to ( n + 1 ) do
     begin
       b := nblend( i , k , u ) ;
       x := x + a[i,1] * b ;
       y := y + a[i,2] * b ;
     end ;
  end ;

procedure drawcurve ;
 begin
   n := ctr ;
   k := 4 ;
   for i := 1 to n-1 do
      draw(arr[i,1],arr[i,2],arr[i+1,1],arr[i+1,2],3) ;
   m := n - k + 2 ;
   for i := 0 to 400 do
    begin
      spline(x,y,i/400 * m,n,k,arr) ;
      plot(round(x),round(y),3) ;
    end ;
 end ;

begin
  x1 := 160 ;
  x2 := x1 ;
  y1 := 100 ;
  y2 := y1 ;
  ctr := 0 ;
  clrscr ;
  graphmode ;
  setnum ;
  c := '0' ;
  while ( ord(c) <> 27 ) do
   begin
    plot(x2,y2,3) ;
    read(kbd,c) ;
    c := upcase(c) ;
    if ( c = 'C' ) then
      drawcurve ;
    if ( c = 'E' ) then
      ctr := 0 ;
    if ( c = 'D' ) then
      draw(x1,y1,x2,y2,3) ;
    case c of
      '8' : begin
              if ( y2 > 0 ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 - 1 ;
               end ;
            end ;
      '2' : begin
              if ( y2 < 199 ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 + 1 ;
               end ;
            end ;
      '4' : begin
              if ( x2 > 0 ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 x2 := x2 - 1 ;
               end ;
            end ;
      '6' : begin
              if ( x2 < 319 ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 x2 := x2 + 1 ;
               end ;
            end ;
      '7' : begin
              if ( ( y2 > 0 ) and ( x2 > 0 ) ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 - 1 ;
                 x2 := x2 - 1 ;
               end ;
            end ;
      '9' : begin
              if ( ( y2 > 0 ) and ( x2 < 319 ) ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 - 1 ;
                 x2 := x2 + 1 ;
               end ;
            end ;
      '1' : begin
              if ( ( y2 < 199 ) and ( x2 > 0 ) ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 + 1 ;
                 x2 := x2 - 1 ;
               end ;
            end ;
      '3' : begin
              if ( ( y2 < 199 ) and ( x2 < 319 ) ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 + 1 ;
                 x2 := x2 + 1 ;
               end ;
            end ;
     end ;
   if ( ord(c) = 13 ) then
    begin
      plot(x2,y2,3) ;
      ctr := ctr + 1 ;
      arr[ctr,1] := x2 ;
      arr[ctr,2] := y2 ;
      flag := 1 ;
      x1 := x2 ;
      y1 := y2 ;
    end ;
  end ;
  resetnum ;
  textmode(bw80) ;
end .
